home *** CD-ROM | disk | FTP | other *** search
/ Amoszine 3 / Amoszine 3.adf / Celebrity_source / colour_fade.AMOS / colour_fade.amosSourceCode
AMOS Source Code  |  1992-02-26  |  5KB  |  200 lines
  1. ' *************************************************************
  2. '
  3. '                  - **  Screen Fade Program ** -  
  4. '
  5. '                        By Paul Nordovics   
  6. '  
  7. ' If you use this in your own programs I won't be offended if
  8. '             you mention me in your creditz !!! 
  9. ' *************************************************************
  10. '
  11. ' _fade[speed,_step,c1,c2] 
  12. '
  13. ' speed = speed of fade (0 = fastest)  
  14. ' _step = gap between each shade of colour 
  15. ' c1 and c2 determine the colour of the fx 
  16. ' c1 indicates which RGB component of colour 0 to reduce 1st 
  17. ' c2 indicates which RGB component of colour 0 to reduce 2nd 
  18. ' the component that is left is then reduced to 0
  19. ' components are numbered as follows:
  20. ' Red   = 0
  21. ' Green = 1
  22. ' Blue  = 2  
  23. ' e.g. c1=0 c2=1 
  24. ' reduce Red component of colour 0 to 0 first
  25. ' reduce Green component of colour 0 to 0 next 
  26. ' reduce Blue component of colour 0 to 0 last  
  27. '
  28. ' best to try different combinations to see what's going on
  29. '
  30. ' when proc is done all colour registers will = 0
  31. ' and the screen will be filled with colour 0 only 
  32. ' -------------------------------------------------------------
  33. '
  34. ' *************
  35. ' set up screen
  36. ' *************
  37. Screen Open 0,320,256,32,Lowres
  38. Curs Off : Flash Off : Hide 
  39. Cls 0 : Paper 0 : Pen 4
  40. Locate ,10
  41. Centre "- Press A Key -"
  42. '
  43. Wait Key 
  44. _FADE[1,6,2,1]
  45. '
  46. End 
  47. '
  48. Procedure _FADE[SPEED,_STEP,C1,C2]
  49.    _COL_NUM=Screen Colour
  50.    R=15*256
  51.    G=15*16
  52.    B=15
  53.    Dim _COL_FLAG(_COL_NUM-1)
  54.    ' *************
  55.    ' fade to white
  56.    ' *************
  57.    Repeat 
  58.       If SPEED>0 Then Wait SPEED
  59.       For K=0 To _COL_NUM-1
  60.          C=Colour(K)
  61.          If C<$FFF
  62.             Add C,$111
  63.             If C>$FFF
  64.                C=$FFF
  65.             End If 
  66.          End If 
  67.          If C=$FFF and _COL_FLAG(K)=0
  68.             Add FLAG,1
  69.             _COL_FLAG(K)=1
  70.          End If 
  71.          Colour K,C
  72.       Next K
  73.    Until FLAG=_COL_NUM
  74.    '
  75.    ' ***********
  76.    ' t'other bit
  77.    ' ***********
  78.    ' ***************************************
  79.    ' this sets up the different colour areas
  80.    ' ***************************************
  81.    For K=0 To _COL_NUM-1
  82.       O=K*_STEP
  83.       Cls K,O,O To 320-O,256-O
  84.    Next K
  85.    ' **************** 
  86.    ' this is the fade 
  87.    ' **************** 
  88.    Repeat 
  89.       If SPEED>0 Then Wait SPEED
  90.       ' *********************
  91.       ' shift colours 1 => 15
  92.       ' *********************
  93.       For K=_COL_NUM-1 To 1 Step -1
  94.          C=Colour(K-1)
  95.          Colour K,C
  96.       Next K
  97.       ' *******************************
  98.       ' work out new value for colour 0
  99.       ' *******************************
  100.       ' **************** 
  101.       ' reduce red first 
  102.       ' **************** 
  103.       If C1=0
  104.          Add R,-256
  105.          If R<0
  106.             R=0
  107.             ' *****************
  108.             ' reduce 2nd choice
  109.             ' *****************
  110.             If C2=1
  111.                Add G,-16
  112.                If G<0
  113.                   G=0
  114.                   Add B,-1
  115.                   If B<0
  116.                      B=0
  117.                   End If 
  118.                End If 
  119.             End If 
  120.             If C2=2
  121.                Add B,-1
  122.                If B<0
  123.                   B=0
  124.                   Add G,-16
  125.                   If G<0
  126.                      G=0
  127.                   End If 
  128.                End If 
  129.             End If 
  130.          End If 
  131.       End If 
  132.       ' ****************** 
  133.       ' reduce green first 
  134.       ' ****************** 
  135.       If C1=1
  136.          Add G,-16
  137.          If G<0
  138.             G=0
  139.             ' *****************
  140.             ' reduce 2nd choice
  141.             ' *****************
  142.             If C2=0
  143.                Add R,-256
  144.                If R<0
  145.                   R=0
  146.                   Add B,-1
  147.                   If B<0
  148.                      B=0
  149.                   End If 
  150.                End If 
  151.             End If 
  152.             If C2=2
  153.                Add B,-1
  154.                If B<0
  155.                   B=0
  156.                   Add R,-256
  157.                   If R<0
  158.                      R=0
  159.                   End If 
  160.                End If 
  161.             End If 
  162.          End If 
  163.       End If 
  164.       ' *****************
  165.       ' reduce blue first
  166.       ' *****************
  167.       If C1=2
  168.          Add B,-1
  169.          If B<0
  170.             B=0
  171.             If C2=0
  172.                Add R,-256
  173.                If R<0
  174.                   R=0
  175.                   Add G,-16
  176.                   If G<0
  177.                      G=0
  178.                   End If 
  179.                End If 
  180.             End If 
  181.             If C2=1
  182.                Add G,-16
  183.                If G<0
  184.                   G=0
  185.                   Add R,-256
  186.                   If R<0
  187.                      R=0
  188.                   End If 
  189.                End If 
  190.             End If 
  191.          End If 
  192.       End If 
  193.       P=R+G+B
  194.       Colour 0,P
  195.    Until Colour(_COL_NUM-1)=0
  196.    ' ******************************************** 
  197.    ' tidy up by filling screen with colour 0 only 
  198.    ' ******************************************** 
  199.    Cls 0
  200. End Proc